#!/usr/bin/perl
# Usage: onoff_fix file

if ($#ARGV < 0) {
    print "\n  Usage: onoff_fix files\n\n";
    print "    Fixes procedues files with onoff=... commands for the new sample proc.\n\n";
    print "    'files' are the files to be fixed\n\n";
    print "    The original files are renamed with a '.bak' extension\n\n";
    print "    It will NOT fix (preliminary) 9.10.5 commands that used a sample proc.\n";
    print "    For those, it will insert a comma, but leave the sample proc appearing\n";
    print "    in the detector list, you will need to find and fix those. Unless you\n";
    print "    have used 9.10.5 and tried an onoff sample proc, this won't be an issue.\n";
    exit -1;
}


$float_pattern='([+-]?)(?=\d|\.\d)\d*(\.\d*)?';

FILE: foreach $name (@ARGV) {

    $bak = $name . ".bak";
    $out = $name;
    if (!-e $name) {
	die "Can't find $name Quitting.\n";
    }

# rename the original if we can and open the files

    if (-e $bak) {
	die "Backup-file $bak already exists, giving up.\n";
    }

    rename ($out,$bak) ||die "renaming $out to $bak failed: $!, giving up.\n";
 
    if(!open(BAK,$bak)) {
	print "Failed to open $bak: $!\n";
	if(!rename($bak,$out)) {
	    print "Unable to rename $bak to $out: $!\n";
	    die "Please fix whatever the problem is and rename it yourself.\n";
	} else {
	    die "I renamed $bak to $out for you.\n";
	}
    }
    
    if(!open(OUT,">" . $out)) {
	print "Failed to open $out: $!\n";
	if((!close(BAK)) || (!rename($bak,$out))) { 
	    print "Unable to rename $bak to $out: $!\n";
	    die "Please fix whatever the problem is and rename it yourself.\n";
	} else {
	    die "I renamed $bak to $out for you.\n";
	}
    }


#process

    $bslash=0;
    $line=0;
    $change=0;
    while(<BAK>) {
	$line++;
#calrx is now obsolete
	if (/^[ ]*calrx/i) {
	    $change=1;
	    next;
# we only fix onoff= commands, even commented out
	} elsif(!/^[\" ]*onoff=/i) {
	    print OUT;
	    next;
#this one was already fixed, skip
	} elsif(/^[^=]+[^,]*,[^,]*,[^,]*,[^,]*,,[^,]*,[1-9]*[a-z]+[0-9]*.*$/) {
	    print OUT;
	    next;
	}
	if(/\\/) {
	    print "onoff=... at  line $line in $out contained a backslash escape sequence, please edit by hand\n";
	    $bslash=1;
	    last;
	}
	$change=1;
	chomp;
#these patterns will fix most common cases
#the first comments out old stylecommands (detectors in the middle),
#couldn't be in use anyway, so presumably just forgotten
	if(/^[\"]*([^=]+[^,]*,[^,]*,[1-9]*[a-z]+[0-9]*,.*)$/) {
	    print OUT "\"$1\n";
#this one corrects olds commands that did not have the wait time added
	} elsif(/^([^=]+[^,]*,[^,]*,[^,]*,[^,]*,)([1-9]*[a-z]+[0-9]*.*)$/) {
	    print OUT "$1,,$2\n";
#this one corrects commands with proc added after wait time (9.10.5 preliminary)
	} elsif(/^([^=]+[^,]*,[^,]*,[^,]*,[^,]*,)([^,]*,),([1-9]*[a-z]+[0-9]*.*)$/) {
	    print OUT "$1,$2$3\n";
#what is left an okay old command that just needs an extra comma.
	} elsif(/^([^=]+[^,]*,[^,]*,[^,]*,[^,]*,)([^,]*,.*)$/) {
	    print OUT "$1,$2\n";
	} else {
	    print "onoff=... at  line $line in $out did not match known pattern, please edit by hand\n";
	    $bslash=1;
	    last;
	} 
    }
    $rename=0;
    if(!close(OUT)) {
	$rename=1;
	print "Warning: Unable to close to $out: $!\n";
    }
    if(!close(BAK)) {
	$rename=1;
	print "Warning: Unable to close to $bak: $!\n";
    }

    if($bslash) {
	$rename=1;
    }
    if($rename || $change == 0) {
	if(!rename($bak,$out)) { 
	    print "Warning: Unable to rename '$bak' to '$out': $!\n";
	    if($rename) {
		print "Warning: Please fix whatever the problem is and rename it yourself,\n";
		print "Warning: probably using 'mv $bak $out'\n";
	    } else {
		print "Warning: It appears that $out did not need any changes,\n";
		print "Warning: but to be safe you should probably \"";
		print "Warning: use 'mv $bak $out'\n";
	    }
	} elsif($rename) {
	    print "Warning: I renamed '$bak' to '$out' for you.\n";

	}
    }
}
